home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kolekce / d3456 / gmprintsuite_eval.exe / {app} / GmLegacy.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-01-09  |  37.1 KB  |  1,274 lines
  1. unit GmLegacy;
  2.  
  3. interface
  4.  
  5. uses Windows, Classes, Graphics, Dialogs, GmTypes, GmObjects;
  6.  
  7. type
  8.   {$IFNDEF VER100}
  9.   PointArray = array of TPoint;
  10.   {$ENDIF}
  11.  
  12.   TGmBaseFileRec = class
  13.   private
  14.     FID: Extended;
  15.   end;
  16.  
  17.   TGmExtFileRec = class(TGmBaseFileRec)
  18.   private
  19.     FValue: Extended;
  20.   end;
  21.  
  22.   TGmIntFileRec = class(TGmBaseFileRec)
  23.   private
  24.     FValue: Integer;
  25.   end;
  26.  
  27.   TGmStrFileRec = class(TGmBaseFileRec)
  28.   private
  29.     FValue: string
  30.   end;
  31.  
  32.   TGmBrushFileRec = class(TGmBaseFileRec)
  33.   private
  34.     FValue: TGmBrush;
  35.   end;
  36.  
  37.   TGmFontFileRec = class(TGmBaseFileRec)
  38.   private
  39.     FValue: TGmFont;
  40.   end;
  41.  
  42.   TGmPenFileRec = class(TGmBaseFileRec)
  43.   private
  44.     FValue: TGmPen;
  45.   end;
  46.  
  47.   TGmExtValueList = class
  48.   private
  49.     //FObjectID    : Extended;
  50.     FExtList: TList;
  51.     FIntList: TList;
  52.     FStrList: TList;
  53.     FBrushList: TList;
  54.     FFontList: TList;
  55.     FPenList: TList;
  56.     FMemoryBuffer: TMemoryStream;
  57.     function GetBoolValue(AIndex: Extended): Boolean;
  58.     function GetExtValue(AIndex: Extended): Extended;
  59.     function GetIntValue(AIndex: Extended): Integer;
  60.     function GetIntValueDef(AIndex: Extended; DefaultVal: integer): Integer;
  61.     function GetStrValue(AIndex: Extended): string;
  62.     function GetGmBrush(AIndex: Extended): TGmBrush;
  63.     function GetGmFont(AIndex: Extended): TGmFont;
  64.     function GetGmPen(AIndex: Extended): TGmPen;
  65.     function FontStringToStyle(AStyle: string): TFontStyles;
  66.     function FontStyleToString(AStyle: TFontStyles): string;
  67.  
  68.   public
  69.     constructor Create;
  70.     destructor Destroy; override;
  71.     procedure LoadFromStream(AStream: TStream);
  72.     procedure SaveToStream(AStream: TStream);
  73.     procedure Clear;
  74.     procedure AddBoolVal(AID: Extended; AValue: Boolean);
  75.     procedure AddExtVal(AID:  Extended; AValue: Extended);
  76.     procedure AddIntVal(AID:  Extended; AValue: Integer);
  77.     procedure AddStrVal(AID:  Extended; AValue: string);
  78.     procedure AddGmBrush(AID: Extended;AGmBrush: TGmBrush);
  79.     procedure AddGmFont(AID: Extended; AGmFont: TGmFont);
  80.     procedure AddGmPen(AID: Extended; AGmPen: TGmPen);
  81.  
  82.     function IntFromStream(AStream: TStream): LongInt;
  83.     function FloatFromStream(AStream: TStream): Extended;
  84.     function StrFromStream(AStream: TStream): string;
  85.     function BrushFromStream(AStream: TStream): TGmBrush;
  86.     function FontFromStream(AStream: TStream): TGmFont;
  87.     function PenFromStream(AStream: TStream): TGmPen;
  88.  
  89.     procedure IntToStream(AStream: TStream; AInteger: LongInt);
  90.     procedure FloatToStream(AStream: TStream; AExtended: Extended);
  91.     procedure StrToStream(AStream: TStream; AString: string);
  92.     procedure BrushToStream(AStream: TStream; ABrush: TGmBrush);
  93.     procedure FontToStream(AStream: TStream; AFont: TGmFont);
  94.     procedure PenToStream(AStream: TStream; APen: TGmPen);
  95.  
  96.     property ValueBool[index: Extended]: Boolean read GetBoolValue;
  97.     property ValueExt[index: Extended]: Extended read GetExtValue;
  98.     //property ValueInt[index: Extended]: Integer read GetIntValue;
  99.     property ValueInt[index: Extended; DefaultVal: integer]: Integer read GetIntValueDef;
  100.     property ValueStr[index: Extended]: string read GetStrValue;
  101.     property ValueBrush[index: Extended]: TGmBrush read GetGmBrush;
  102.     property ValueFont[index: Extended]: TGmFont read GetGmFont;
  103.     property ValuePen[index: Extended]: TGmPen read GetGmPen;
  104.  
  105.   end;
  106.  
  107.   procedure LoadFromStreamOld(APreview: TComponent; AStream: TStream);
  108.   procedure LoadOldObject({APreview: TComponent;} NewObject: TGmBaseObject; AValues: TGmExtValueList);
  109.  
  110.   function BitmapFromStream(Fs: TStream): TBitmap;
  111. function BoolFromStream(Fs: TStream): Boolean;
  112. procedure BitmapToStream(Fs: TStream; AGraphic: TBitmap);
  113. procedure BoolToStream(Fs: TStream; ABoolean: Boolean);
  114. procedure BrushFromStream(Fs: TStream; var ABrush: TGmBrush);
  115. procedure BrushToStream(Fs: TStream; ABrush: TGmBrush);
  116. function FloatFromStream(Fs: TStream): Extended;
  117. procedure FloatToStream(Fs: TStream; AExtended: Extended);
  118. procedure FontFromStream(Fs: TStream; var AFont: TGmFont);
  119. procedure FontToStream(Fs: TStream; AFont: TGmFont);
  120. function IntFromStream(Fs: TStream): LongInt;
  121. procedure IntToStream(Fs: TStream; AInteger: LongInt);
  122. function MetafileFromStream(Fs: TStream): TMetaFile;
  123. procedure MetaFileToStream(Fs: TStream; AGraphic: TMetaFile);
  124. procedure PenFromStream(Fs: TStream; var APen: TGmPen);
  125. procedure PenToStream(Fs: TStream; APen: TGmPen);
  126. function StrFromStream(Fs: TStream): string;
  127. procedure StrToStream(Fs: TStream; AString: string);
  128. function FontStringToStyle(AStyle: string): TFontStyles;
  129. function FontStyleToString(AStyle: TFontStyles): string;
  130.  
  131. procedure StringToStream(AString: string; AStream: TStream);
  132. function  StreamToString(AStream: TStream): string;
  133.  
  134. function BitmapFromString(AString: string): TBitmap;
  135. function BitmapToString(ABitmap: TBitmap): string;
  136. function MetafileFromString(AString: string): TMetafile;
  137. function MetafileToString(AMetafile: TMetafile): string;
  138. {$IFNDEF VER100}
  139. function PolyPointsToString(APoints: PointArray): string;
  140. procedure PolyPointsFromString(var APoints: PointArray; AString: string);
  141. {$ENDIF}
  142.  
  143. implementation
  144.  
  145. uses GmConst, SysUtils, GmPreview;
  146.  
  147. procedure LoadFromStreamOld(APreview: TComponent; AStream: TStream);
  148. var
  149.   AValues: TGmExtValueList;
  150.   NewObject: TGmBaseObject;
  151.   // two page variables used to give OnLoadProgress information...
  152.   //TotalPages: integer;
  153.   Preview: TGmPreview;
  154.   FirstPage: Boolean;
  155. begin
  156.   // introduced with v2.14...
  157.  
  158.   FirstPage := True;
  159.  
  160.   //FPreviewState := gmLoading;
  161.   Preview := TGmPreview(APreview);
  162.   Preview.MessagesEnabled := False;
  163.   Preview.Clear;
  164.   AValues := TGmExtValueList.Create;
  165.   with AValues do
  166.   try
  167.     while AStream.Position < AStream.Size do
  168.     begin
  169.       NewObject := nil;  // initialise the page object.
  170.       // page setup...
  171.       AValues.LoadFromStream(AStream);
  172.       case ValueInt[C_OBJECT, -1] of
  173.         C_NEW_PAGE:
  174.         begin
  175.           if not FirstPage then Preview.NewPage;
  176.           FirstPage := False;
  177.           //Inc(CurrentTotal);
  178.           //if Assigned(FOnLoadProgress) then FOnLoadProgress(Self, Round((CurrentTotal/TotalPages)*100));
  179.         end;
  180.         C_PAGE_SETUP:
  181.         begin
  182.           Preview.PageWidth.AsUnits   := AValues.ValueInt[C_PAGE_WIDTH, 0];
  183.           Preview.PageHeight.AsUnits  := AValues.ValueInt[C_PAGE_HEIGHT, 0];
  184.           Preview.PaperSize           := TGmPaperSize(AValues.ValueInt[C_PAPER_SIZE, 0]);
  185.           Preview.Orientation         := TGmOrientation(AValues.ValueInt[C_ORIENTATION, 0]);
  186.         end;
  187.         C_MARGIN:
  188.         begin
  189.           Preview.Margins.Left.AsUnits   := ValueInt[C_MARGIN_LEFT, 0];
  190.           Preview.Margins.Top.AsUnits    := ValueInt[C_MARGIN_TOP, 0];
  191.           Preview.Margins.Right.AsUnits  := ValueInt[C_MARGIN_RIGHT, 0];
  192.           Preview.Margins.Bottom.AsUnits := ValueInt[C_MARGIN_BOTTOM, 0];
  193.           Preview.Margins.Visible        := Boolean(ValueInt[C_MARGIN_VISIBLE, 0]);
  194.           Preview.Margins.ShowPrinterMargins := Boolean(ValueInt[C_PRINT_MARGIN_VISIBLE, 0]);
  195.           GmPenToPen(Preview.Margins.Pen, ValuePen[C_MARGINS_PEN_1]);
  196.           GmPenToPen(Preview.Margins.PrinterMarginPen, ValuePen[C_MARGINS_PEN_2]);
  197.         end;
  198.         C_SHADOW:
  199.         begin
  200.           Preview.Shadow.Color    := AValues.ValueInt[C_SHADOW_COLOR, 0];
  201.           Preview.Shadow.Width    := AValues.ValueInt[C_SHADOW_WIDTH, 0];
  202.           Preview.Shadow.Visible  := Boolean(AValues.ValueInt[C_SHADOW_VISIBLE, 0]);
  203.         end;
  204.         C_DOCUMENT:
  205.         begin
  206.           // nothing is currently done with these values... (for future use)
  207.           ValueExt[C_DOCUMENT_CREATED];
  208.           //TotalPages := ValueInt[C_DOCUMENT_NUMPAGES, 0];
  209.         end;
  210.         C_HEADER:
  211.         begin
  212.           Preview.Header.ShowLine  := Boolean(AValues.ValueInt[C_HEADER_SHOWLINE, 0]);
  213.           Preview.Header.Visible   := Boolean(AValues.ValueInt[C_HEADER_VISIBLE, 0]);
  214.           //Preview.Header.CaptionLeft.LoadFromString(AValues.ValueStr[C_CAPTION_LEFT]);
  215.           //Preview.Header.CaptionCenter.LoadFromString(AValues.ValueStr[C_CAPTION_CENTER]);
  216.           //Preview.Header.CaptionRight.LoadFromString(AValues.ValueStr[C_CAPTION_RIGHT]);
  217.           GmPenToPen(Preview.Header.Pen, AValues.ValuePen[C_PEN]);
  218.         end;
  219.         C_FOOTER:
  220.         begin
  221.           Preview.Footer.ShowLine  := Boolean(AValues.ValueInt[C_FOOTER_SHOWLINE, 0]);
  222.           Preview.Footer.Visible   := Boolean(AValues.ValueInt[C_FOOTER_VISIBLE, 0]);
  223.           ///Preview.Footer.FCaptionLeft.LoadFromString(AValues.ValueStr[C_CAPTION_LEFT]);
  224.           //Preview.Footer.FCaptionCenter.LoadFromString(AValues.ValueStr[C_CAPTION_CENTER]);
  225.           //Preview.Footer.FCaptionRight.LoadFromString(AValues.ValueStr[C_CAPTION_RIGHT]);
  226.           GmPenToPen(Preview.Footer.Pen, AValues.ValuePen[C_PEN]);
  227.         end;
  228.         C_OBJECT:
  229.         begin
  230.           case ValueInt[C_OBJECT_ID, -1] of
  231.             1: NewObject := TGmTextObject.Create;
  232.             2: NewObject := TGmLineObject.Create;
  233.             3: NewObject := TGmEllipseShape.Create;
  234.             4: NewObject := TGmRectangleShape.Create;
  235.             5: NewObject := TGmRoundRectShape.Create;
  236.             6: NewObject := TGmTextBoxObject.Create;
  237.             {$IFNDEF VER100}
  238.             7:  NewObject := TGmPolygonObject.Create;
  239.             8:  NewObject := TGmPolyLineObject.Create;
  240.             13: NewObject := TGmPolyBezierObject.Create;
  241.             {$ENDIF}
  242.             9:  NewObject := TGmGraphicObject.Create;
  243.             10: NewObject := TGmArcShape.Create;
  244.             11: NewObject := TGmChordShape.Create;
  245.             12: NewObject := TGmPieShape.Create;
  246.  
  247.           end;
  248.           if Assigned(NewObject) then
  249.           begin
  250.             LoadOldObject(NewObject, AValues);
  251.             Preview.Canvas.Page.AddObject(NewObject);
  252.           end;
  253.         end;
  254.       end;
  255.     end;
  256.   finally
  257.     AValues.Free;
  258.     // update the display...
  259.     Preview.MessagesEnabled := True;
  260.     Preview.UpdatePreview;
  261.   end;
  262. end;
  263.  
  264. procedure LoadOldObject({APreview: TComponent;} NewObject: TGmBaseObject; AValues: TGmExtValueList);
  265. //var
  266.   //Preview: TGmPreview;
  267. begin
  268.   //Preview := TGmPreview(APreview);
  269.   if (NewObject is TGmSimpleShape) then
  270.   begin
  271.     with (NewObject as TGmSimpleShape) do
  272.     begin
  273.       Page  := AValues.ValueInt[C_OBJECT_PAGE, 1];
  274.       X     := AValues.ValueInt[C_OBJECT_X1, 0];
  275.       Y     := AValues.ValueInt[C_OBJECT_Y1, 0];
  276.       X2    := AValues.ValueInt[C_OBJECT_X2, 0];
  277.       Y2    := AValues.ValueInt[C_OBJECT_Y2, 0];
  278.       if (NewObject is TGmRoundRectShape) then
  279.       begin
  280.         TGmRoundRectShape(NewObject).X3 := AValues.ValueInt[C_OBJECT_X3, 0];
  281.         TGmRoundRectShape(NewObject).Y3 := AValues.ValueInt[C_OBJECT_Y3, 0];
  282.       end;
  283.       if (NewObject is TGmComplexShape) then
  284.       begin
  285.         TGmComplexShape(NewObject).X3 := AValues.ValueInt[C_OBJECT_X3, 0];
  286.         TGmComplexShape(NewObject).Y3 := AValues.ValueInt[C_OBJECT_Y3, 0];
  287.         TGmComplexShape(NewObject).X4 := AValues.ValueInt[C_OBJECT_X4, 0];
  288.         TGmComplexShape(NewObject).Y4 := AValues.ValueInt[C_OBJECT_Y4, 0];
  289.       end;
  290.       Brush := AValues.ValueBrush[C_BRUSH];
  291.       Pen   := AValues.ValuePen[C_PEN];
  292.     end;
  293.   end
  294.   else
  295.   if (NewObject is TGmLineObject) then
  296.   begin
  297.     with (NewObject as TGmLineObject) do
  298.     begin
  299.       Page     := AValues.ValueInt[C_OBJECT_PAGE, 1];
  300.       X        := AValues.ValueInt[C_OBJECT_X1, 0];
  301.       Y        := AValues.ValueInt[C_OBJECT_Y1, 0];
  302.       X2       := AValues.ValueInt[C_OBJECT_X2, 0];
  303.       Y2       := AValues.ValueInt[C_OBJECT_Y2, 0];
  304.       LineType := TGmLineType(AValues.ValueInt[C_OBJECT_LINE_TYPE, 0]);
  305.       if LineType = GmLineExt then showmessage('d');
  306.       Pen      := AValues.ValuePen[C_PEN];
  307.     end;
  308.   end
  309.   else
  310.   if (NewObject is TGmTextObject) then
  311.   begin
  312.     with (NewObject as TGmTextObject) do
  313.     begin
  314.       Page     := AValues.ValueInt[C_OBJECT_PAGE, 1];
  315.       X        := AValues.ValueInt[C_OBJECT_X1, 0];
  316.       Y        := AValues.ValueInt[C_OBJECT_Y1, 0];
  317.       Brush    := AValues.ValueBrush[C_BRUSH]; //GetGmBrush;
  318.       Font     := AValues.ValueFont[C_FONT]; //GetGmFont;
  319.       Caption  := AValues.ValueStr[C_CAPTION];
  320.       if (NewObject is TGmTextBoxObject) then
  321.       begin
  322.         TGmTextBoxObject(NewObject).X2         := AValues.ValueInt[C_OBJECT_X2, 0];
  323.         TGmTextBoxObject(NewObject).Y2         := AValues.ValueInt[C_OBJECT_Y2, 0];
  324.         TGmTextBoxObject(NewObject).Alignment  := TAlignment(AValues.ValueInt[C_ALIGNMENT, 0]);
  325.         TGmTextBoxObject(NewObject).VertAlignment:= AValues.ValueInt[C_VERT_ALIGNMENT, 0];
  326.         TGmTextBoxObject(NewObject).Pen        := AValues.ValuePen[C_PEN];
  327.       end;
  328.     end;
  329.   end
  330.     else
  331.   if (NewObject is TGmGraphicObject) then
  332.   begin
  333.     with (NewObject as TGmGraphicObject) do
  334.     begin
  335.       Page     := AValues.ValueInt[C_OBJECT_PAGE, 1];
  336.       X        := AValues.ValueInt[C_OBJECT_X1, 0];
  337.       Y        := AValues.ValueInt[C_OBJECT_Y1, 0];
  338.       X2           := AValues.ValueInt[C_OBJECT_X2, 0];
  339.       Y2           := AValues.ValueInt[C_OBJECT_Y2, 0];
  340.       AType         := TGmGraphicType(AValues.ValueInt[C_OBJECT_DATA1, 0]);
  341.       DrawAsBitmap := AValues.ValueBool[C_METAFILE_AS_BITMAP];
  342.       if AType = gtBitmap then
  343.         Bitmap := BitmapFromString(AValues.ValueStr[C_BITMAP])
  344.       else
  345.       if AType = gtMetafile then
  346.         Metafile := MetafileFromString(AValues.ValueStr[C_METAFILE]);
  347.     end;
  348.   end;
  349. end;
  350.  
  351.  
  352.  
  353. constructor TGmExtValueList.Create;
  354. begin
  355.   inherited;
  356.   FExtList := TList.Create;
  357.   FIntList := TList.Create;
  358.   FStrList := TList.Create;
  359.   FBrushList := TList.Create;
  360.   FFontList  := TList.Create;
  361.   FPenList   := TList.Create;
  362.   FMemoryBuffer := TMemoryStream.Create;
  363. end;
  364.  
  365. destructor TGmExtValueList.Destroy;
  366. begin
  367.   FMemoryBuffer.Free;
  368.   FExtList.Free;
  369.   FIntList.Free;
  370.   FStrList.Free;
  371.   FBrushList.Free;
  372.   FFontList.Free;
  373.   FPenList.Free;
  374.   inherited;
  375. end;
  376.  
  377. function TGmExtValueList.GetBoolValue(AIndex: Extended): Boolean;
  378. begin
  379.   Result := Boolean(GetIntValue(AIndex));
  380. end;
  381.  
  382. function TGmExtValueList.GetExtValue(AIndex: Extended): Extended;
  383. var
  384.   ICount: integer;
  385.   SearchRec: TGmExtFileRec;
  386. begin
  387.   Result := 0;
  388.   for ICount := 0 to FExtList.Count-1 do
  389.   begin
  390.     SearchRec := TGmExtFileRec(FExtList[ICount]);
  391.     if SearchRec.FID = AIndex then
  392.     begin
  393.       Result := SearchRec.FValue;
  394.       Break;
  395.     end;
  396.   end;
  397. end;
  398.  
  399. function TGmExtValueList.GetIntValue(AIndex: Extended): Integer;
  400. var
  401.   ICount: integer;
  402.   SearchRec: TGmIntFileRec;
  403. begin
  404.   Result := 0;
  405.   for ICount := 0 to FIntList.Count-1 do
  406.   begin
  407.     SearchRec := TGmIntFileRec(FIntList[ICount]);
  408.     if SearchRec.FID = AIndex then
  409.     begin
  410.       Result := SearchRec.FValue;
  411.       Break;
  412.     end;
  413.   end;
  414. end;
  415.  
  416. function TGmExtValueList.GetIntValueDef(AIndex: Extended; DefaultVal: integer): Integer;
  417. var
  418.   ICount: integer;
  419.   SearchRec: TGmIntFileRec;
  420. begin
  421.   Result := DefaultVal;
  422.   for ICount := 0 to FIntList.Count-1 do
  423.   begin
  424.     SearchRec := TGmIntFileRec(FIntList[ICount]);
  425.     if SearchRec.FID = AIndex then
  426.     begin
  427.       Result := SearchRec.FValue;
  428.       Break;
  429.     end;
  430.   end;
  431. end;
  432.  
  433. function TGmExtValueList.GetStrValue(AIndex: Extended): string;
  434. var
  435.   ICount: integer;
  436.   SearchRec: TGmStrFileRec;
  437. begin
  438.   Result := '';
  439.   for ICount := 0 to FStrList.Count-1 do
  440.   begin
  441.     SearchRec := TGmStrFileRec(FStrList[ICount]);
  442.     if SearchRec.FID = AIndex then 
  443.     begin
  444.       Result := SearchRec.FValue;
  445.       Break ;
  446.     end;
  447.   end;
  448. end;
  449.  
  450. function TGmExtValueList.GetGmBrush(AIndex: Extended): TGmBrush;
  451. var
  452.   ICount: integer;
  453.   SearchRec: TGmBrushFileRec;
  454. begin
  455.   for ICount := 0 to FBrushList.Count-1 do
  456.   begin
  457.     SearchRec := TGmBrushFileRec(FBrushList[ICount]);
  458.     if SearchRec.FID = AIndex then 
  459.     begin
  460.       Result := SearchRec.FValue;
  461.       Break ;
  462.     end;
  463.   end;
  464. end;
  465.  
  466. function TGmExtValueList.GetGmFont(AIndex: Extended): TGmFont;
  467. var
  468.   ICount: integer;
  469.   SearchRec: TGmFontFileRec;
  470. begin
  471.   for ICount := 0 to FFontList.Count-1 do
  472.   begin
  473.     SearchRec := TGmFontFileRec(FFontList[ICount]);
  474.     if SearchRec.FID = AIndex then
  475.     begin
  476.       Result := SearchRec.FValue;
  477.       Break ;
  478.     end;
  479.   end;
  480. end;
  481.  
  482. function TGmExtValueList.GetGmPen(AIndex: Extended): TGmPen;
  483. var
  484.   ICount: integer;
  485.   SearchRec: TGmPenFileRec;
  486. begin
  487.   for ICount := 0 to FPenList.Count-1 do
  488.   begin
  489.     SearchRec := TGmPenFileRec(FPenList[ICount]);
  490.     if SearchRec.FID = AIndex then
  491.     begin
  492.       Result := SearchRec.FValue;
  493.       Break;
  494.     end;
  495.   end;
  496. end;
  497.  
  498. function TGmExtValueList.FontStringToStyle(AStyle: string): TFontStyles;
  499. begin
  500.   Result := [];
  501.   if Pos('B', AStyle) <> 0 then Result := Result + [fsBold];
  502.   if Pos('I', AStyle) <> 0 then Result := Result + [fsItalic];
  503.   if Pos('U', AStyle) <> 0 then Result := Result + [fsUnderline];
  504.   if Pos('S', AStyle) <> 0 then Result := Result + [fsStrikeOut];
  505. end;
  506.  
  507.  
  508. function TGmExtValueList.FontStyleToString(AStyle: TFontStyles): string;
  509. begin
  510.   Result := '';
  511.   if (fsBold in AStyle)      then Result := Result + 'B';
  512.   if (fsItalic in AStyle)    then Result := Result + 'I';
  513.   if (fsUnderline in AStyle) then Result := Result + 'U';
  514.   if (fsStrikeOut in AStyle) then Result := Result + 'S';
  515. end;
  516.  
  517. procedure TGmExtValueList.LoadFromStream(AStream: TStream);
  518. var
  519.   StreamSize: integer;
  520.   ObjectType: integer;
  521.   AExtRec   : TGmExtFileRec;
  522.   AIntRec   : TGmIntFileRec;
  523.   AStrRec   : TGmStrFileRec;
  524.   ABrushRec : TGmBrushFileRec;
  525.   AFontRec  : TGmFontFileRec;
  526.   APenRec   : TGmPenFileRec;
  527. begin
  528.   Clear;
  529.   FMemoryBuffer.Clear;
  530.  
  531.   StreamSize := IntFromStream(AStream);
  532.   FMemoryBuffer.SetSize(StreamSize);
  533.   FMemoryBuffer.CopyFrom(AStream, StreamSize);
  534.   FMemoryBuffer.Seek(0, soFromBeginning);
  535.   while (FMemoryBuffer.Position < FMemoryBuffer.Size) do
  536.   begin
  537.     ObjectType := IntFromStream(FMemoryBuffer);
  538.     case ObjectType of
  539.       C_EXTENDED:
  540.       begin
  541.         // create and add the Extended record...
  542.         AExtRec       := TGmExtFileRec.Create;
  543.         AExtRec.FID   := FloatFromStream(FMemoryBuffer);
  544.         AExtRec.FValue:= FloatFromStream(FMemoryBuffer);
  545.         FExtList.Add(AExtRec);
  546.       end;
  547.       C_INTEGER :
  548.       begin
  549.         // create and add the integer record...
  550.         AIntRec       := TGmIntFileRec.Create;
  551.         AIntRec.FID   := FloatFromStream(FMemoryBuffer);
  552.         AIntRec.FValue:= IntFromStream(FMemoryBuffer);
  553.         FIntList.Add(AIntRec);
  554.       end;
  555.       C_STRING  :
  556.       begin
  557.         // create and add the string record...
  558.         AStrRec       := TGmStrFileRec.Create;
  559.         AStrRec.FID   := FloatFromStream(FMemoryBuffer);
  560.         AStrRec.FValue:= StrFromStream(FMemoryBuffer);
  561.         FStrList.Add(AStrRec);
  562.       end;
  563.       C_BRUSH  :
  564.       begin
  565.         // create and add the string record...
  566.         ABrushRec       := TGmBrushFileRec.Create;
  567.         ABrushRec.FID   := FloatFromStream(FMemoryBuffer);
  568.         ABrushRec.FValue:= BrushFromStream(FMemoryBuffer);
  569.         FBrushList.Add(ABrushRec);
  570.       end;
  571.       C_FONT  :
  572.       begin
  573.         // create and add the string record...
  574.         AFontRec       := TGmFontFileRec.Create;
  575.         AFontRec.FID   := FloatFromStream(FMemoryBuffer);
  576.         AFontRec.FValue:= FontFromStream(FMemoryBuffer);
  577.         FFontList.Add(AFontRec);
  578.       end;
  579.       C_PEN  :
  580.       begin
  581.         // create and add the string record...
  582.         APenRec       := TGmPenFileRec.Create;
  583.         APenRec.FID   := FloatFromStream(FMemoryBuffer);
  584.         APenRec.FValue:= PenFromStream(FMemoryBuffer);
  585.         FPenList.Add(APenRec);
  586.       end;
  587.     end;
  588.   end;
  589. end;
  590.  
  591. procedure TGmExtValueList.SaveToStream(AStream: TStream);
  592. var
  593.   ICount: integer;
  594.   AExtRec: TGmExtFileRec;
  595.   AIntRec: TGmIntFileRec;
  596.   AStrRec: TGmStrFileRec;
  597.   ABrushRec: TGmBrushFileRec;
  598.   AFontRec: TGmFontFileRec;
  599.   APenRec: TGmPenFileRec;
  600. begin
  601.   with FMemoryBuffer do
  602.   try
  603.     // write the file object ID...
  604.     //FloatToStream(MemStream, FObjectID);
  605.     // write the values to the list...
  606.     for ICount := 0 to FExtList.Count-1 do
  607.     begin
  608.       AExtRec := TGmExtFileRec(FExtList[ICount]);
  609.       IntToStream(FMemoryBuffer, C_EXTENDED);
  610.       FloatToStream(FMemoryBuffer, AExtRec.FID);
  611.       FloattoStream(FMemoryBuffer, AExtRec.FValue);
  612.     end;
  613.     for ICount := 0 to FIntList.Count-1 do
  614.     begin
  615.       AIntRec := TGmIntFileRec(FIntList[ICount]);
  616.       IntToStream(FMemoryBuffer, C_INTEGER);
  617.       FloatToStream(FMemoryBuffer, AIntRec.FID);
  618.       IntToStream(FMemoryBuffer, AIntRec.FValue);
  619.     end;
  620.     for ICount := 0 to FStrList.Count-1 do
  621.     begin
  622.       AStrRec := TGmStrFileRec(FStrList[ICount]);
  623.       IntToStream(FMemoryBuffer, C_STRING);
  624.       FloatToStream(FMemoryBuffer, AStrRec.FID);
  625.       StrToStream(FMemoryBuffer, AStrRec.FValue);
  626.     end;
  627.     for ICount := 0 to FBrushList.Count-1 do
  628.     begin
  629.       ABrushRec := TGmBrushFileRec(FBrushList[ICount]);
  630.       IntToStream(FMemoryBuffer, C_BRUSH);
  631.       FloatToStream(FMemoryBuffer, ABrushRec.FID);
  632.       BrushToStream(FMemoryBuffer, ABrushRec.FValue);
  633.     end;
  634.     for ICount := 0 to FFontList.Count-1 do
  635.     begin
  636.       AFontRec := TGmFontFileRec(FFontList[ICount]);
  637.       IntToStream(FMemoryBuffer, C_FONT);
  638.       FloatToStream(FMemoryBuffer, AFontRec.FID);
  639.       FontToStream(FMemoryBuffer, AFontRec.FValue);
  640.     end;
  641.     for ICount := 0 to FPenList.Count-1 do
  642.     begin
  643.       APenRec := TGmPenFileRec(FPenList[ICount]);
  644.       IntToStream(FMemoryBuffer, C_PEN);
  645.       FloatToStream(FMemoryBuffer, APenRec.FID);
  646.       PenToStream(FMemoryBuffer, APenRec.FValue);
  647.     end;
  648.   finally
  649.     IntToStream(AStream, FMemoryBuffer.Size);
  650.     FMemoryBuffer.SaveToStream(AStream);
  651.     FMemoryBuffer.Clear;
  652.   end;
  653.   Clear;
  654. end;
  655.  
  656. procedure TGmExtValueList.Clear;
  657. var
  658.   ICount: integer;
  659. begin
  660.   // clear the ExtList...
  661.   for ICount := 0 to FExtList.Count-1 do
  662.     TGmExtFileRec(FExtList[ICount]).Free;
  663.   FExtList.Clear;
  664.   // clear the IntList...
  665.   for ICount := 0 to FIntList.Count-1 do
  666.     TGmIntFileRec(FIntList[ICount]).Free;
  667.   FIntList.Clear;
  668.   // clear the StrList...
  669.   for ICount := 0 to FStrList.Count-1 do
  670.     TGmStrFileRec(FStrList[ICount]).Free;
  671.   FStrList.Clear;
  672.   // clear the BrushList...
  673.   for ICount := 0 to FBrushList.Count-1 do
  674.     TGmBrushFileRec(FBrushList[ICount]).Free;
  675.   FBrushList.Clear;
  676.   // clear the FontList...
  677.   for ICount := 0 to FFontList.Count-1 do
  678.     TGmFontFileRec(FFontList[ICount]).Free;
  679.   FFontList.Clear;
  680.   // clear the PenList...
  681.   for ICount := 0 to FPenList.Count-1 do
  682.     TGmPenFileRec(FPenList[ICount]).Free;
  683.   FPenList.Clear;
  684. end;
  685.  
  686. procedure TGmExtValueList.AddBoolVal(AID: Extended; AValue: Boolean);
  687. begin
  688.   AddIntVal(AID, Ord(AValue));
  689. end;
  690.  
  691. procedure TGmExtValueList.AddExtVal(AID: Extended; AValue: Extended);
  692. var
  693.   NewObj: TGmExtFileRec;
  694. begin
  695.   NewObj := TGmExtFileRec.Create;
  696.   NewObj.FID := AID;
  697.   NewObj.FValue := AValue;
  698.   FExtList.Add(NewObj);
  699. end;
  700.  
  701. procedure TGmExtValueList.AddIntVal(AID: Extended; AValue: Integer);
  702. var
  703.   NewObj: TGmIntFileRec;
  704. begin
  705.   NewObj := TGmIntFileRec.Create;
  706.   NewObj.FID := AID;
  707.   NewObj.FValue := AValue;
  708.   FIntList.Add(NewObj);
  709. end;
  710.  
  711. procedure TGmExtValueList.AddStrVal(AID: Extended; AValue: string);
  712. var
  713.   NewObj: TGmStrFileRec;
  714. begin
  715.   NewObj := TGmStrFileRec.Create;
  716.   NewObj.FID := AID;
  717.   NewObj.FValue := AValue;
  718.   FStrList.Add(NewObj);
  719. end;
  720.  
  721. procedure TGmExtValueList.AddGmBrush(AID: Extended; AGmBrush: TGmBrush);
  722. var
  723.   NewObj: TGmBrushFileRec;
  724. begin
  725.   NewObj := TGmBrushFileRec.Create;
  726.   NewObj.FID := AID;
  727.   NewObj.FValue := AGmBrush;
  728.   FBrushList.Add(NewObj);
  729. end;
  730.  
  731. procedure TGmExtValueList.AddGmFont(AID: Extended; AGmFont: TGmFont);
  732. var
  733.   NewObj: TGmFontFileRec;
  734. begin
  735.   NewObj := TGmFontFileRec.Create;
  736.   NewObj.FID := AID;
  737.   NewObj.FValue := AGmFont;
  738.   FFontList.Add(NewObj);
  739. end;
  740.  
  741. procedure TGmExtValueList.AddGmPen(AID: Extended; AGmPen: TGmPen);
  742. var
  743.   NewObj: TGmPenFileRec;
  744. begin
  745.   NewObj := TGmPenFileRec.Create;
  746.   NewObj.FID := AID;
  747.   NewObj.FValue := AGmPen;
  748.   FPenList.Add(NewObj);
  749. end;
  750.  
  751. function TGmExtValueList.IntFromStream(AStream: TStream): LongInt;
  752. begin
  753.   AStream.ReadBuffer(Result, SizeOf(Result));
  754. end;
  755.  
  756. function TGmExtValueList.FloatFromStream(AStream: TStream): Extended;
  757. begin
  758.   AStream.ReadBuffer(Result, SizeOf(Result));
  759. end;
  760.  
  761. function TGmExtValueList.StrFromStream(AStream: TStream): string;
  762. var
  763.   StrLength: integer;
  764.   AString: string;
  765. begin
  766.   AStream.ReadBuffer(StrLength, SizeOf(StrLength));
  767.   SetLength(AString, StrLength);
  768.   if StrLength > 0 then
  769.     AStream.ReadBuffer(AString[1], StrLength);
  770.   Result := AString;
  771. end;
  772.  
  773. function TGmExtValueList.BrushFromStream(AStream: TStream): TGmBrush;
  774. var
  775.   BrushValues: TGmExtValueList;
  776. begin
  777.   BrushValues := TGmExtValueList.Create;
  778.   try
  779.     BrushValues.LoadFromStream(AStream);
  780.     Result.Color := BrushValues.ValueInt[C_BRUSH_COLOR, 0];
  781.     Result.Style := TBrushStyle(BrushValues.ValueInt[C_BRUSH_STYLE, Ord(bsSolid)]);
  782.   finally
  783.     BrushValues.Free;
  784.   end;
  785. end;
  786.  
  787. function TGmExtValueList.FontFromStream(AStream: TStream): TGmFont;
  788. var
  789.   FontValues: TGmExtValueList;
  790. begin
  791.   FontValues := TGmExtValueList.Create;
  792.   try
  793.     FontValues.LoadFromStream(AStream);
  794.     Result.Name  := FontValues.ValueStr[C_FONT_NAME];
  795.     Result.Angle := FontValues.ValueExt[C_FONT_ANGLE];
  796.     Result.Size  := FontValues.ValueInt[C_FONT_SIZE, 12];
  797.     Result.Color := FontValues.ValueInt[C_FONT_COLOR, clBlack];
  798.     Result.Style := FontStringToStyle(FontValues.ValueStr[C_FONT_STYLE]);
  799.   finally
  800.     FontValues.Free;
  801.   end;
  802. end;
  803.  
  804. function TGmExtValueList.PenFromStream(AStream: TStream): TGmPen;
  805. var
  806.   PenValues: TGmExtValueList;
  807. begin
  808.   PenValues := TGmExtValueList.Create;
  809.   try
  810.     PenValues.LoadFromStream(AStream);
  811.     Result.Color := PenValues.ValueInt[C_PEN_COLOR, clBlack];
  812.     Result.Width := PenValues.ValueInt[C_PEN_WIDTH, 1];
  813.     Result.Style := TPenStyle(PenValues.ValueInt[C_PEN_STYLE, Ord(psSolid)]);
  814.     Result.Mode  := TPenMode(PenValues.ValueInt[C_PEN_MODE, Ord(pmCopy)]);
  815.   finally
  816.     PenValues.Free;
  817.   end;
  818. end;
  819.  
  820. procedure TGmExtValueList.IntToStream(AStream: TStream; AInteger: LongInt);
  821. var
  822.   WriteInt: LongInt;
  823. begin
  824.   WriteInt := AInteger;
  825.   AStream.WriteBuffer(WriteInt, SizeOf(WriteInt));
  826. end;
  827.  
  828. procedure TGmExtValueList.FloatToStream(AStream: TStream; AExtended: Extended);
  829. var
  830.   WriteFloat: Extended;
  831. begin
  832.   WriteFloat := AExtended;
  833.   AStream.WriteBuffer(WriteFloat, SizeOf(WriteFloat));
  834. end;
  835.  
  836. procedure TGmExtValueList.StrToStream(AStream: TStream; AString: string);
  837. var
  838.   StrLength: integer;
  839. begin
  840.   StrLength := Length(AString);
  841.   AStream.Write(StrLength, SizeOf(StrLength));
  842.   if StrLength > 0 then
  843.   AStream.Write(AString[1], StrLength);
  844. end;
  845.  
  846. procedure TGmExtValueList.BrushToStream(AStream: TStream; ABrush: TGmBrush);
  847. var
  848.   BrushValues: TGmExtValueList;
  849. begin
  850.   BrushValues := TGmExtValueList.Create;
  851.   try
  852.     BrushValues.AddIntVal(C_BRUSH_COLOR, ABrush.Color);
  853.     BrushValues.AddIntVal(C_BRUSH_STYLE, Ord(ABrush.Style));
  854.     BrushValues.SaveToStream(AStream);
  855.   finally
  856.     BrushValues.Free;
  857.   end;
  858. end;
  859.  
  860. procedure TGmExtValueList.FontToStream(AStream: TStream; AFont: TGmFont);
  861. var
  862.   FontValues: TGmExtValueList;
  863. begin
  864.   FontValues := TGmExtValueList.Create;
  865.   try
  866.     FontValues.AddStrVal(C_FONT_NAME, AFont.Name);
  867.     FontValues.AddExtVal(C_FONT_ANGLE, AFont.Angle);
  868.     FontValues.AddIntVal(C_FONT_SIZE, AFont.Size);
  869.     FontValues.AddIntVal(C_FONT_COLOR, AFont.Color);
  870.     FontValues.AddStrVal(C_FONT_STYLE, FontStyleToString(AFont.Style));
  871.     FontValues.SaveToStream(AStream);
  872.   finally
  873.     FontValues.Free;
  874.   end;
  875. end;
  876.  
  877. procedure TGmExtValueList.PenToStream(AStream: TStream; APen: TGmPen);
  878. var
  879.   PenValues: TGmExtValueList;
  880. begin
  881.   PenValues := TGmExtValueList.Create;
  882.   try
  883.     PenValues.AddIntVal(C_PEN_COLOR, APen.Color);
  884.     PenValues.AddIntVal(C_PEN_WIDTH, APen.Width);
  885.     PenValues.AddIntVal(C_PEN_STYLE, Ord(APen.Style));
  886.     PenValues.AddIntVal(C_PEN_MODE , Ord(APen.Mode));
  887.     PenValues.SaveToStream(AStream);
  888.   finally
  889.     PenValues.Free;
  890.   end;
  891. end;
  892.  
  893. //------------------------------------------------------------------------------
  894.  
  895. function BitmapFromStream(Fs: TStream): TBitmap;
  896. begin
  897.   Result := TBitmap.Create;
  898.   Result.LoadFromStream(Fs);
  899. end;
  900.  
  901. procedure BitmapToStream(Fs: TStream; AGraphic: TBitmap);
  902. begin
  903.   AGraphic.SaveToStream(Fs);
  904. end;
  905.  
  906. //------------------------------------------------------------------------------
  907.  
  908. function BoolFromStream(Fs: TStream): Boolean;
  909. begin
  910.   Fs.ReadBuffer(Result, SizeOf(Result));
  911. end;
  912.  
  913. procedure BoolToStream(Fs: TStream; ABoolean: Boolean);
  914. begin
  915.   Fs.WriteBuffer(ABoolean, SizeOf(ABoolean));
  916. end;
  917.  
  918. //------------------------------------------------------------------------------
  919.  
  920. procedure BrushFromStream(Fs: TStream; var ABrush: TGmBrush);
  921. var
  922.   AColor: TColor;
  923.   AStyle: TBrushStyle;
  924. begin
  925.   AColor := ABrush.Color;
  926.   AStyle := ABrush.Style;
  927.   with Fs do
  928.   begin
  929.     ReadBuffer(AColor, SizeOf(AColor));
  930.     ReadBuffer(AStyle, SizeOf(AStyle));
  931.   end;
  932.   ABrush.Color := AColor;
  933.   ABrush.Style := AStyle;
  934. end;
  935.  
  936. procedure BrushToStream(Fs: TStream; ABrush: TGmBrush);
  937. var
  938.   AColor: TColor;
  939.   AStyle: TBrushStyle;
  940. begin
  941.   AColor := ABrush.Color;
  942.   AStyle := ABrush.Style;
  943.   with Fs do
  944.   begin
  945.     WriteBuffer(AColor, SizeOf(AColor));
  946.     WriteBuffer(AStyle, SizeOf(AStyle));
  947.   end;
  948. end;
  949.  
  950. //------------------------------------------------------------------------------
  951.  
  952. function FloatFromStream(Fs: TStream): Extended;
  953. begin
  954.   Fs.ReadBuffer(Result, SizeOf(Result));
  955. end;
  956.  
  957. procedure FloatToStream(Fs: TStream; AExtended: Extended);
  958. var
  959.   WriteFloat: Extended;
  960. begin
  961.   WriteFloat := AExtended;
  962.   Fs.WriteBuffer(WriteFloat, SizeOf(WriteFloat));
  963. end;
  964.  
  965. //------------------------------------------------------------------------------
  966.  
  967. procedure FontFromStream(Fs: TStream; var AFont: TGmFont);
  968. var
  969.   AStyle: TFontStyles;
  970. begin
  971.   AFont.Name := StrFromStream(Fs);
  972.   AFont.Size := IntFromStream(Fs);
  973.   AFont.Color := IntFromStream(Fs);
  974.   AFont.Angle := 0;
  975.   Fs.Read(AStyle, SizeOf(AStyle));
  976.   AFont.Style := AStyle;
  977. end;
  978.  
  979. procedure FontToStream(Fs: TStream; AFont: TGmFont);
  980. var
  981.   AStyle: TFontStyles;
  982. begin
  983.   AStyle := AFont.Style;
  984.   StrToStream(Fs, AFont.Name);
  985.   IntToStream(Fs, AFont.Size);
  986.   Fs.Write(AFont.Color, SizeOf(AFont.Color));
  987.   Fs.Write(AStyle, SizeOf(AStyle));
  988. end;
  989.  
  990. //------------------------------------------------------------------------------
  991.  
  992. function IntFromStream(Fs: TStream): LongInt;
  993. begin
  994.   Fs.ReadBuffer(Result, SizeOf(Result));
  995. end;
  996.  
  997. procedure IntToStream(Fs: TStream; AInteger: LongInt);
  998. var
  999.   WriteInt: LongInt;
  1000. begin
  1001.   WriteInt := AInteger;
  1002.   Fs.WriteBuffer(WriteInt, SizeOf(WriteInt));
  1003. end;
  1004.  
  1005. //------------------------------------------------------------------------------
  1006.  
  1007. function MetafileFromStream(Fs: TStream): TMetaFile;
  1008. var
  1009.   MS: TMemoryStream;
  1010.   MetafileSize: integer;
  1011. begin
  1012.   // I have had to implement these two metafile functions because of
  1013.   // bugs found in the TMetaFile.SaveToStream/LoadFromStream methods...
  1014.   Result := TMetafile.Create;
  1015.   MetafileSize := IntFromStream(Fs);
  1016.   MS := TMemoryStream.Create;
  1017.   MS.CopyFrom(Fs, MetaFileSize);
  1018.   MS.Seek(0, soFromBeginning);
  1019.   Result.LoadFromStream(MS);
  1020.   MS.Clear;
  1021.   MS.Free;
  1022. end;
  1023.  
  1024. procedure MetaFileToStream(Fs: TStream; AGraphic: TMetaFile);
  1025. var
  1026.   MS: TMemoryStream;
  1027. begin
  1028.   MS := TMemoryStream.Create;
  1029.   AGraphic.SaveToStream(MS);
  1030.   IntToStream(Fs, MS.Size);
  1031.   MS.SaveToStream(Fs);
  1032.   MS.Clear;
  1033.   MS.Free;
  1034. end;
  1035.  
  1036. //------------------------------------------------------------------------------
  1037.  
  1038. procedure PenFromStream(Fs: TStream; var APen: TGmPen);
  1039. var
  1040.   AColor: TColor;
  1041.   AStyle: TPenStyle;
  1042.   AWidth: Integer;
  1043. begin
  1044.   with Fs do
  1045.   begin
  1046.     Fs.ReadBuffer(AColor, SizeOf(AColor));
  1047.     Fs.ReadBuffer(AStyle, SizeOf(AStyle));
  1048.     Fs.ReadBuffer(AWidth, SizeOf(AWidth));
  1049.   end;
  1050.   APen.Color := AColor;
  1051.   APen.Style := AStyle;
  1052.   APen.Width := AWidth;
  1053. end;
  1054.  
  1055. procedure PenToStream(Fs: TStream; APen: TGmPen);
  1056. var
  1057.   AColor: TColor;
  1058.   AStyle: TPenStyle;
  1059.   AWidth: Integer;
  1060. begin
  1061.   AColor := APen.Color;
  1062.   AStyle := APen.Style;
  1063.   AWidth := APen.Width;
  1064.   with Fs do
  1065.   begin
  1066.     Fs.WriteBuffer(AColor, SizeOf(AColor));
  1067.     Fs.WriteBuffer(AStyle, SizeOf(AStyle));
  1068.     Fs.WriteBuffer(AWidth, SizeOf(AWidth));
  1069.   end;
  1070. end;
  1071.  
  1072. //------------------------------------------------------------------------------
  1073.  
  1074. function StrFromStream(Fs: TStream): string;
  1075. var
  1076.   StrLength: integer;
  1077.   AString: string;
  1078. begin
  1079.   Fs.ReadBuffer(StrLength, SizeOf(StrLength));
  1080.   SetLength(AString, StrLength);
  1081.   if StrLength > 0 then
  1082.     Fs.ReadBuffer(AString[1], StrLength);
  1083.   Result := AString;
  1084. end;
  1085.  
  1086. procedure StrToStream(Fs: TStream; AString: string);
  1087. var
  1088.   StrLength: integer;
  1089. begin
  1090.   StrLength := Length(AString);
  1091.   Fs.Write(StrLength, SizeOf(StrLength));
  1092.   //if StrLength > 0 then
  1093.   Fs.Write(AString[1], StrLength);
  1094. end;
  1095.  
  1096. //------------------------------------------------------------------------------
  1097.  
  1098. function FontStringToStyle(AStyle: string): TFontStyles;
  1099. begin
  1100.   Result := [];
  1101.   if Pos('B', AStyle) <> 0 then Result := Result + [fsBold];
  1102.   if Pos('I', AStyle) <> 0 then Result := Result + [fsItalic];
  1103.   if Pos('U', AStyle) <> 0 then Result := Result + [fsUnderline];
  1104.   if Pos('S', AStyle) <> 0 then Result := Result + [fsStrikeOut];
  1105. end;
  1106.  
  1107.  
  1108. function FontStyleToString(AStyle: TFontStyles): string;
  1109. begin
  1110.   Result := '';
  1111.   if (fsBold in AStyle)      then Result := Result + 'B';
  1112.   if (fsItalic in AStyle)    then Result := Result + 'I';
  1113.   if (fsUnderline in AStyle) then Result := Result + 'U';
  1114.   if (fsStrikeOut in AStyle) then Result := Result + 'S';
  1115. end;
  1116.  
  1117. //------------------------------------------------------------------------------
  1118.  
  1119. {$IFNDEF VER100}
  1120.  
  1121. function PolyPointsToString(APoints: PointArray): string;
  1122. var
  1123.   AList: TStringList;
  1124.   ICount: integer;
  1125. begin
  1126.   AList := TStringList.Create;
  1127.   try
  1128.     for ICount := 0 to High(APoints) do
  1129.     begin
  1130.       AList.Add(IntToStr(APoints[ICount].x));
  1131.       AList.Add(IntToStr(APoints[ICount].y));
  1132.     end;
  1133.     Result := AList.CommaText;
  1134.   finally
  1135.     AList.Free;
  1136.   end;
  1137. end;
  1138.  
  1139. procedure PolyPointsFromString(var APoints: PointArray; AString: string);
  1140. var
  1141.   AList: TStringList;
  1142.   ICount: integer;
  1143. begin
  1144.   AList := TStringList.Create;
  1145.   try
  1146.     AList.CommaText := AString;
  1147.     SetLength(APoints, AList.Count div 2);
  1148.     ICount := 0;
  1149.     while ICount <> AList.Count do
  1150.     begin
  1151.       APoints[ICount div 2].x := StrToInt(AList[ICount]);
  1152.       APoints[ICount div 2].y := StrToInt(AList[ICount+1]);
  1153.       Inc(ICount, 2);
  1154.     end;
  1155.   finally
  1156.     AList.Free;
  1157.   end;
  1158. end;
  1159.  
  1160. {$ENDIF}
  1161.  
  1162. //------------------------------------------------------------------------------
  1163.  
  1164. procedure StringToStream(AString: string; AStream: TStream);
  1165. begin
  1166.   if Assigned(AStream) then
  1167.     AStream.Write(Pointer(AString)^, Length(AString));
  1168. end;
  1169.  
  1170. function  StreamToString(AStream: TStream): string;
  1171. begin
  1172.   if Assigned(AStream) then
  1173.   begin
  1174.     AStream.Seek(soFromBeginning, 0);
  1175.     SetString(Result, PChar(nil), AStream.Size);
  1176.     AStream.ReadBuffer(Pointer(Result)^, AStream.Size);
  1177.   end
  1178.   else
  1179.     Result := '';
  1180. end;
  1181.  
  1182. //------------------------------------------------------------------------------
  1183.  
  1184. function BitmapFromString(AString: string): TBitmap;
  1185. var
  1186.   AStream: TMemoryStream;
  1187. begin
  1188.   Result := nil;
  1189.   if AString <> '' then
  1190.   begin
  1191.     AStream := TMemoryStream.Create;
  1192.     try
  1193.       StringToStream(AString, AStream);
  1194.       AStream.Seek(soFromBeginning, 0);
  1195.       Result := TBitmap.Create;
  1196.       Result.LoadFromStream(AStream);
  1197.     finally
  1198.       AStream.Free;
  1199.     end;
  1200.   end;
  1201. end;
  1202.  
  1203. function BitmapToString(ABitmap: TBitmap): string;
  1204. var
  1205.   AStream: TMemoryStream;
  1206. begin
  1207.   AStream := TMemoryStream.Create;
  1208.   try
  1209.     ABitmap.SaveToStream(AStream);
  1210.     Result := StreamToString(AStream);
  1211.   finally
  1212.     AStream.Free;
  1213.   end;
  1214. end;
  1215.  
  1216. function MetafileFromString(AString: string): TMetafile;
  1217. var
  1218.   AStream: TMemoryStream;
  1219. begin
  1220.   Result := nil;
  1221.   if AString <> '' then
  1222.   begin
  1223.     AStream := TMemoryStream.Create;
  1224.     try
  1225.       StringToStream(AString, AStream);
  1226.       AStream.Seek(soFromBeginning, 0);
  1227.       Result := TMetafile.Create;
  1228.       Result := MetafileFromStream(AStream);
  1229.     finally
  1230.       AStream.Free;
  1231.     end;
  1232.   end;
  1233. end;
  1234.  
  1235. function MetafileToString(AMetafile: TMetafile): string;
  1236. var
  1237.   AStream: TMemoryStream;
  1238. begin
  1239.   AStream := TMemoryStream.Create;
  1240.   try
  1241.     MetaFileToStream(AStream, AMetafile);
  1242.     Result := StreamToString(AStream);
  1243.   finally
  1244.     AStream.Free;
  1245.   end;
  1246. end;
  1247.  
  1248. //------------------------------------------------------------------------------
  1249.  
  1250. {function PenToString(APen: TPen): string;
  1251. var
  1252.   AStream: TMemoryStream;
  1253.   TempInt: integer;
  1254. begin
  1255.   AStream := TMemoryStream.Create;
  1256.   try
  1257.     with AStream do
  1258.     begin
  1259.       TempInt := APen.Color;
  1260.       AStream.Write(TempInt, SizeOf(TempInt));
  1261.       Result := StreamToString(AStream);
  1262.     end;
  1263.   finally
  1264.     AStream.Free;
  1265.   end;
  1266. end;
  1267.  
  1268. procedure PenFromString(AString: string; APen: TPen);
  1269. begin
  1270.  
  1271. end;}
  1272.  
  1273. end.
  1274.